home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / MPW_TOOL / TOOLS / TOOLS_WI / ICON_8 / ICONX_FO / OCOMP.C < prev    next >
Text File  |  1990-03-02  |  8KB  |  389 lines

  1. /*
  2.  * File: ocomp.c
  3.  *  Contents: lexeq, lexge, lexgt, lexle, lexlt, lexne, numeq, numge,
  4.  *        numgt, numle, numlt, numne, eqv, neqv
  5.  */
  6.  
  7. #include "::h:config.h"
  8. #include "::h:rt.h"
  9. #include "rproto.h"
  10.  
  11. #ifdef PreProcess
  12. /* include(../M4/ops.m4) /* */
  13. /* */
  14. #endif                    /* PreProcess */
  15.  
  16. /*
  17.  * x == y - test if x is lexically equal to y.
  18.  */
  19.  
  20. OpDcl(lexeq,2,"==")
  21.    {
  22.    register int t;
  23.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  24.  
  25.    /*
  26.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  27.     *  because Arg2 is the result (if any).
  28.     */
  29.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  30.       RunErr(103, &Arg1);
  31.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  32.       RunErr(103, &Arg2);
  33.  
  34.  
  35.    /*
  36.     * If the strings have different lengths they cannot be equal.
  37.     */
  38.    if (StrLen(Arg1) != StrLen(Arg2))
  39.       Fail;
  40.  
  41.    /*
  42.     * lexcmp does the work.
  43.     */
  44.    if (lexcmp(&Arg1, &Arg2) != Equal)
  45.       Fail;
  46.  
  47.    /*
  48.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  49.     *  a string, a copy of it is allocated.
  50.     */
  51.    Arg0 = Arg2;
  52.    if (t == Cvt) {
  53.       if (strreq(StrLen(Arg0)) == Error) 
  54.          RunErr(0, NULL);
  55.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  56.       }
  57.    Return;
  58.    }
  59.  
  60. /*
  61.  * x >>= y - test if x is lexically greater than or equal to y.
  62.  */
  63.  
  64. OpDcl(lexge,2,">>=")
  65.    {
  66.    register int t;
  67.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  68.  
  69.    /*
  70.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  71.     *  because Arg2 is the result (if any).
  72.     */
  73.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  74.       RunErr(103, &Arg1);
  75.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  76.       RunErr(103, &Arg2);
  77.  
  78.    /*
  79.     * lexcmp does the work.
  80.     */
  81.    if (lexcmp(&Arg1, &Arg2) == Less)
  82.       Fail;
  83.  
  84.    /*
  85.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  86.     *  a string, a copy of it is allocated.
  87.     */
  88.    Arg0 = Arg2;
  89.    if (t == Cvt) {
  90.       if (strreq(StrLen(Arg0)) == Error) 
  91.          RunErr(0, NULL);
  92.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  93.       }
  94.    Return;
  95.    }
  96.  
  97. /*
  98.  * x >> y - test if x is lexically greater than y.
  99.  */
  100.  
  101. OpDcl(lexgt,2,">>")
  102.    {
  103.    register int t;
  104.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  105.  
  106.    /*
  107.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  108.     *  because Arg2 is the result (if any).
  109.     */
  110.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  111.       RunErr(103, &Arg1);
  112.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  113.       RunErr(103, &Arg2);
  114.  
  115.    /*
  116.     * lexcmp does the work.
  117.     */
  118.    if (lexcmp(&Arg1, &Arg2) != Greater)
  119.       Fail;
  120.  
  121.    /*
  122.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  123.     *  a string, a copy of it is allocated.
  124.     */
  125.    Arg0 = Arg2;
  126.    if (t == Cvt) {
  127.       if (strreq(StrLen(Arg0)) == Error) 
  128.          RunErr(0, NULL);
  129.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  130.       }
  131.    Return;
  132.    }
  133.  
  134. /*
  135.  * x <<= y - test if x is lexically less than or equal to y.
  136.  */
  137.  
  138. OpDcl(lexle,2,"<<=")
  139.    {
  140.    register int t;
  141.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  142.  
  143.    /*
  144.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  145.     *  because Arg2 is the result (if any).
  146.     */
  147.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  148.       RunErr(103, &Arg1);
  149.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  150.       RunErr(103, &Arg2);
  151.  
  152.    /*
  153.     * lexcmp does the work.
  154.     */
  155.    if (lexcmp(&Arg1, &Arg2) == Greater)
  156.       Fail;
  157.  
  158.    /*
  159.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  160.     *  a string, a copy of it is allocated.
  161.     */
  162.    Arg0 = Arg2;
  163.    if (t == Cvt) {
  164.       if (strreq(StrLen(Arg0)) == Error) 
  165.          RunErr(0, NULL);
  166.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  167.       }
  168.    Return;
  169.    }
  170.  
  171. /*
  172.  * x << y - test if x is lexically less than y.
  173.  */
  174.  
  175. OpDcl(lexlt,2,"<<")
  176.    {
  177.    register int t;
  178.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  179.  
  180.    /*
  181.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  182.     *  because Arg2 is the result (if any).
  183.     */
  184.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  185.       RunErr(103, &Arg1);
  186.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  187.       RunErr(103, &Arg2);
  188.  
  189.    /*
  190.     * lexcmp does the work.
  191.     */
  192.    if (lexcmp(&Arg1, &Arg2) != Less)
  193.       Fail;
  194.  
  195.    /*
  196.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  197.     *  a string, a copy of it is allocated.
  198.     */
  199.    Arg0 = Arg2;
  200.    if (t == Cvt) {        /* string needs to be allocated */
  201.       if (strreq(StrLen(Arg0)) == Error) 
  202.          RunErr(0, NULL);
  203.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  204.       }
  205.    Return;
  206.    }
  207.  
  208. /*
  209.  * x ~== y - test if x is lexically not equal to y.
  210.  */
  211.  
  212. OpDcl(lexne,2,"~==")
  213.    {
  214.    register int t;
  215.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  216.  
  217.    /*
  218.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  219.     *  because Arg2 is the result (if any).
  220.     */
  221.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  222.       RunErr(103, &Arg1);
  223.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  224.       RunErr(103, &Arg2);
  225.  
  226.  
  227.    /*
  228.     * If the strings have different lengths they are not equal.
  229.     * If lengths are the same, let lexcmp do the work.
  230.     */
  231.    if (StrLen(Arg1) == StrLen(Arg2) && lexcmp(&Arg1, &Arg2) == Equal)
  232.       Fail;
  233.  
  234.    /*
  235.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  236.     *  a string, a copy of it is allocated.
  237.     */
  238.    Arg0 = Arg2;
  239.    if (t == Cvt) {        /* string needs to be allocated */
  240.       if (strreq(StrLen(Arg0)) == Error) 
  241.          RunErr(0, NULL);
  242.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  243.       }
  244.    Return;
  245.    }
  246.  
  247. /*
  248.  * x = y - test if x is numerically equal to y.
  249.  */
  250.  
  251. OpDcl(numeq,2,"=")
  252.    {
  253.  
  254.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  255.       case Equal:
  256.          Return;
  257.       case Greater:
  258.       case Less:
  259.          Fail;
  260.       case Error: 
  261.          RunErr(0, NULL);
  262.       }
  263.    }
  264.  
  265. /*
  266.  * x >= y - test if x is numerically greater or equal to y.
  267.  */
  268.  
  269. OpDcl(numge,2,">=")
  270.    {
  271.  
  272.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  273.       case Greater:
  274.       case Equal:
  275.          Return;
  276.       case Less:
  277.          Fail;
  278.       case Error: 
  279.          RunErr(0, NULL);
  280.       }
  281.    }
  282.  
  283. /*
  284.  * x > y - test if x is numerically greater than y.
  285.  */
  286.  
  287. OpDcl(numgt,2,">")
  288.    {
  289.  
  290.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  291.       case Greater:
  292.          Return;
  293.       case Less:
  294.       case Equal:
  295.          Fail;
  296.       case Error: 
  297.          RunErr(0, NULL);
  298.       }
  299.    }
  300.  
  301. /*
  302.  * x <= y - test if x is numerically less than or equal to y.
  303.  */
  304.  
  305. OpDcl(numle,2,"<=")
  306.    {
  307.  
  308.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  309.       case Less:
  310.       case Equal:
  311.          Return;
  312.       case Greater:
  313.          Fail;
  314.       case Error: 
  315.          RunErr(0, NULL);
  316.       }
  317.    }
  318.  
  319. /*
  320.  * x < y - test if x is numerically less than y.
  321.  */
  322.  
  323. OpDcl(numlt,2,"<")
  324.    {
  325.  
  326.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  327.       case Less:
  328.          Return;
  329.       case Greater:
  330.       case Equal:
  331.          Fail;
  332.       case Error: 
  333.          RunErr(0, NULL);
  334.       }
  335.    }
  336.  
  337. /*
  338.  * x ~= y - test if x is numerically not equal to y.
  339.  */
  340.  
  341. OpDcl(numne,2,"~=")
  342.  
  343.    {
  344.  
  345.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  346.       case Less:
  347.       case Greater:
  348.          Return;
  349.       case Equal:
  350.          Fail;
  351.       case Error: 
  352.          RunErr(0, NULL);
  353.       }
  354.    Return;
  355.    }
  356.  
  357. /*
  358.  * x === y - test equivalence of Arg1 and Arg2.
  359.  */
  360.  
  361. OpDcl(eqv,2,"===")
  362.    {
  363.  
  364.    /*
  365.     * Let equiv do all the work, failing if equiv indicates non-equivalence.
  366.     */
  367.    if (!equiv(&Arg1, &Arg2))
  368.       Fail;
  369.  
  370.    Arg0 = Arg2;
  371.    Return;
  372.    }
  373.  
  374. /*
  375.  * x ~=== y - test inequivalence of Arg1 and Arg2.
  376.  */
  377.  
  378. OpDcl(neqv,2,"~===")
  379.    {
  380.  
  381.    /*
  382.     * equiv does all the work.
  383.     */
  384.    if (equiv(&Arg1, &Arg2))
  385.       Fail;
  386.    Arg0 = Arg2;
  387.    Return;
  388.    }
  389.